#!/usr/bin/perl
use strict;
use Data::Dumper;
use Getopt::Long;
use File::Basename;
use Cwd 'abs_path';
#use lib '/homes/smandal/work/dcg/om/graph';
use JNPR::Utils;
my $g_sql_out = [];

my $bindir = abs_path(dirname($0));
my $db = "$bindir/db";

my $g_allclusters = {};
my $g_all_parentages = [];
my $g_all_merge_arrows = [];
my $g_requested_branches = {};

my $opts = {};
GetOptions($opts, 'slim', 'slim5', 'curves', 'asof=i', 'rewrite=s', 'svnroot=s');

read_graph();
consolidate_clusters();
consolidate_parentages();
consolidate_merge_arrows();
rewrite_graph();
cut_asof();
make_slim_or_slim5();

print "digraph SVN_BRANCHES {\n\n";
unless (exists $opts->{curves}) {
    print "    splines=false\n\n";
}
print_clusters();
print_parentages();
print_merge_arrows();
print "}\n\n";

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub read_graph
{
    my $do_thing;
    my $things = [];
    while (my $line = <>) {
        $line =~ s/^\s*//;
        $line =~ s/\#.*//s;
        $line =~ s/\s*$//;
        $line =~ s/\s+/ /g;
        next if ($line eq '');
        chomp $line;
        if ($line eq '{') {
            $do_thing = \&collect_cluster;
            @$things = ();
        }
        elsif ($line eq 'parentage {') {
            $do_thing = \&collect_parentage;
            @$things = ();
        }
        elsif ($line eq 'merges {') {
            $do_thing = \&collect_merge_arrows;
            @$things = ();
        }
        elsif ($line eq 'requested_branches {') {
            $do_thing = \&collect_requested_branches;
            @$things = ();
        }
        elsif ($line eq '}') {
            &$do_thing($things);
        }
        else {
            push @$things, $line;
        }
    }
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub rewrite_graph
{
    return unless (exists $opts->{rewrite});
    open my $f, '>' . $opts->{rewrite} or die;

    print $f "requested_branches {\n";
    for my $branch (keys %{$g_requested_branches}) {
        print $f "$branch\n";
    }
    print $f "}\n\n";

    for my $branch (sort by_youth keys %{$g_allclusters}) {
        print $f "{\n$branch\n";
        for my $r (sort {$a <=> $b} keys %{$g_allclusters->{$branch}->{revs}}) {
            print $f "${r}|" . $g_allclusters->{$branch}->{revs}->{$r} . "\n";
        }
        print $f "}\n\n";
    }

    if (scalar @{$g_all_parentages}) {
        print $f "parentage {\n";
        print $f join "\n", @{$g_all_parentages};
        print $f "\n}\n\n";
    }

    if (scalar @{$g_all_merge_arrows}) {
        print $f "merges {\n";
        for my $arrow (@{$g_all_merge_arrows}) {
            my ($lrev, $rrev) = split /\s*->\s*/, $arrow;
            my $lbranch = JNPR::Utils::get_branch_of_rev($db,$lrev);
            my $rbranch = JNPR::Utils::get_branch_of_rev($db,$rrev);
            print $f "$lbranch\@$lrev -> $rbranch\@$rrev\n";
        }
        print $f "}\n\n";
    }

    close $f;
    exit;
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub make_slim_or_slim5
{

    my $slim = 'none'; 
    if (exists $opts->{slim}) {
        $slim = 1;
    }
    elsif (exists $opts->{slim5}) {
        $slim = 5;
    }
    return if ($slim eq 'none');

    #
    # Keep only the latest merge arrows between two branches
    # Or, last 5 in case of slim5
    #
    my $nodepairs = {};
    for my $arrow (@$g_all_merge_arrows) {
        my ($node_from, $node_to) = $arrow =~ m{^(\d+)\s*->\s*(\d+)$};
        my $branch_from = JNPR::Utils::get_branch_of_rev($db,$node_from);
        my $branch_to   = JNPR::Utils::get_branch_of_rev($db,$node_to);
        my $branchpair = "$branch_from-$branch_to";
        if (!exists $nodepairs->{$branchpair}) {
            $nodepairs->{$branchpair} = [];
        }
        push @{$nodepairs->{$branchpair}}, "$node_from -> $node_to";
    }

    my @new_arrows = ();
    for my $branchpair (keys %{$nodepairs}) {
        @{$nodepairs->{$branchpair}} =
          sort {$b <=> $a} @{$nodepairs->{$branchpair}};
        if ($slim == 1) {
            push @new_arrows, @{$nodepairs->{$branchpair}}[0];
        }
        elsif ($slim == 5) {
            # How many arrows do we have for this branchpair?
            my $n = scalar @{$nodepairs->{$branchpair}};

            #take that many arrows, or, max 5
            $n = ($n < 5) ? $n-1 : 4;
            push @new_arrows, @{$nodepairs->{$branchpair}}[0 .. $n];
        }
    }

    @$g_all_merge_arrows = @new_arrows;

    #
    # Keep only the arrowful revision nodes. Get rid of nodes
    # not associated with some kind of lines. But keep the first
    # rev on each branch.
    #

    my @parent_child_nodes =
            map {
                  my ($x, $y) = split /\s*->\s*/, $_;
                  ($x, $y);
                }
            @{$g_all_parentages};

    my @merge_arrow_nodes =
            map {
                  my ($x, $y) = split /\s*->\s*/, $_;
                  ($x, $y);
                }
            @{$g_all_merge_arrows};

    my @earliest_revs_on_branches = ();
    for my $branch (keys %{$g_allclusters}) {
        push @earliest_revs_on_branches, $g_allclusters->{$branch}->{earliest_rev};
    }

    my %important_nodes =
            map {$_, 1}
            (@parent_child_nodes, @merge_arrow_nodes, @earliest_revs_on_branches);

    for my $branch (keys %{$g_allclusters}) {
        my @revs = keys %{$g_allclusters->{$branch}->{revs}};
        for my $r (@revs) {
            if (! exists $important_nodes{$r}) {
                delete $g_allclusters->{$branch}->{revs}->{$r};
            }
        }
        @revs = sort {$a <=> $b} keys %{$g_allclusters->{$branch}->{revs}};
        $g_allclusters->{$branch}->{earliest_rev} = shift @revs;
    }

    # Now, if branches are left with 
    #    only one rev now,
    #       and 
    #    that rev is not a parent rev for another branch
    #       and 
    #    if the branch is not one of the originally requested
    # get rid of the branch.
    # These must be useless branches where nothing ever happenned.
    # The first rev must be the creation rev of the branch.

#smandal
    my $deleted_something = 1;
    while ($deleted_something)
#smandal
    {
        $deleted_something = 0;
        my %parent_revs = ();
        for my $parent_arrow (@{$g_all_parentages}) {
            # '346488 -> DEV_FX_MAIN_BRANCH@347680',
            # '347680 -> DEV_FX_WS_BRANCH@347687',
            # '348657 -> DEV_EX_FIXX2_0912_BRANCH@350007',
            my ($parent_rev) = $parent_arrow =~ /^(.+?)\s*\->/;
            $parent_revs{$parent_rev} = 1;
        }

        my %deleted_branches = ();

        for my $branch (keys %{$g_allclusters}) {
            my @revs = keys %{$g_allclusters->{$branch}->{revs}};
            my ($just_branchname) = $branch =~ /^([^\@]+)/;
            if (    (scalar @revs == 1)
                 && (!exists $parent_revs{$revs[0]}) 
                 && (!exists $g_requested_branches->{$just_branchname}) 
               )
            {
                delete $g_allclusters->{$branch};
                $deleted_branches{$branch} = 1;
                $deleted_something = 1;
            }
        }

        # Also from the parentage list.
        my @new_parentages = ();
        for my $parent_arrow (@{$g_all_parentages}) {
            # '346488 -> DEV_FX_MAIN_BRANCH@347680',
            # '347680 -> DEV_FX_WS_BRANCH@347687',
            # '348657 -> DEV_EX_FIXX2_0912_BRANCH@350007',
            my ($branch) = $parent_arrow =~ /\->\s*(.+)$/;
            if (!exists $deleted_branches{$branch}) {
                push @new_parentages, $parent_arrow;
            }
        }
        @{$g_all_parentages} = @new_parentages;
    }





}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub cut_asof
{
    return unless (exists $opts->{asof});
    # $g_allclusters = {};
    # $g_all_parentages = [];
    # $g_all_merge_arrows = [];
    for my $branch (keys %$g_allclusters) {
        for my $r (keys %{$g_allclusters->{$branch}->{revs}}) {
            if ($r > $opts->{asof}) {
                delete $g_allclusters->{$branch}->{revs}->{$r};
            }
        }
        unless (scalar keys %{$g_allclusters->{$branch}->{revs}}) {
            delete $g_allclusters->{$branch};
        }
    }

    @{$g_all_parentages} =
        grep {
                my ($x) = $_ =~ /^(\d+)/;
                ($x <= $opts->{asof}) ? 1 : 0;
             }
        @{$g_all_parentages};

    
    @{$g_all_merge_arrows} =
        grep {
                my ($x, $y) = $_ =~ /^(\d+).+?(\d+)$/;
                (($x <= $opts->{asof}) && ($y <= $opts->{asof})) ? 1 : 0;
             }
        @{$g_all_merge_arrows};
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub print_merge_arrows
{
    for my $arrow (@$g_all_merge_arrows) {
        my ($r1, $r2) = split /\s*->\s*/, $arrow;
        my $branch1 = JNPR::Utils::get_branch_of_rev($db,$r1);
        my $branch2 = JNPR::Utils::get_branch_of_rev($db,$r2);
        my $tooltip = "$branch1\@$r1->$branch2\@$r2";
        my $branch1_full_name = JNPR::Utils::branch_full_name($db,$branch1,$r1);
        my $color = $g_allclusters->{$branch1_full_name}->{color};
        print "    \"$r1\" -> \"$r2\" [color=$color,style=bold,arrowhead=vee,arrowtail=inv,dir=both,tooltip=\"$tooltip\"]\n";
    }
    print "\n";
}


#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub print_parentages
{
    for my $umbilical (@$g_all_parentages) {
        my ($parent_rev, $thisbranch) = split /\s*->\s*/, $umbilical;
        my $parentbranch = JNPR::Utils::get_branch_of_rev($db,$parent_rev);
        my $tooltip = "$parentbranch\@$parent_rev->$thisbranch";
        print "    \"$parent_rev\" -> \"$thisbranch\" [arrowhead=vee,arrowtail=inv,style=bold,dir=both,tooltip=\"$tooltip\"]\n";
    }
    print "\n";
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub collect_merge_arrows
{
    my $arrows = shift;
    for my $arrow (@$arrows) {
        # The arrow comes in any of these four formats
        #
        # 407183 -> 407266
        # 407183 -> DEV_FX_SILA_BRANCH@407266
        # DEV_FX_SI_BRANCH@407183 -> 407266
        # DEV_FX_SI_BRANCH@407183 -> DEV_FX_SILA_BRANCH@407266
        #
        # Let's just stick to the truth, rev -> rev

        my ($left, $right) = split /\s*->\s*/, $arrow;
        my ($lrev) = $left  =~ /(\d+)$/;
        my ($rrev) = $right =~ /(\d+)$/;

        my $lbranch = JNPR::Utils::get_branch_of_rev($db, $lrev);
        my $rbranch = JNPR::Utils::get_branch_of_rev($db, $rrev);

        my $lbranch_full_name = JNPR::Utils::branch_full_name($db, $lbranch, $lrev);
        my $rbranch_full_name = JNPR::Utils::branch_full_name($db, $rbranch, $rrev);

        if (!exists $g_allclusters->{$lbranch_full_name}->{revs}->{$lrev}) {
            my $date = getdate($lrev);
            $g_allclusters->{$lbranch_full_name}->{revs}->{$lrev} = $date;
        }

        if (!exists $g_allclusters->{$rbranch_full_name}->{revs}->{$rrev}) {
            my $date = getdate($rrev);
            $g_allclusters->{$rbranch_full_name}->{revs}->{$rrev} = $date;
        }
        push @{$g_all_merge_arrows}, "$lrev -> $rrev";
    }
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub collect_requested_branches
{
    my $branches = shift;
    for my $branch (@{$branches}) {
        $g_requested_branches->{$branch} = 1;
    }
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub collect_parentage
{
    my $parentages = shift;
    push @{$g_all_parentages}, @{$parentages};
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub collect_cluster
{
    my $nodes = shift;
    my $branch = shift @$nodes;

    my ($r, $date);
    for my $node (@$nodes) {
        if ($node =~ /^(\d+)\|(.+)$/) {
            ($r, $date) = ($1, $2);
        }
        elsif ($node =~ /^\d+$/) {
            $r = $node;
            $date = getdate($r);
        }
        else {
            die "Error: $node has problem\n";
        }
        $g_allclusters->{$branch}->{revs}->{$r} = $date;
    }
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub getdate
{
    my ($r) = @_;
    my $sql = "select date from nodes where rev = $r";
    JNPR::Utils::sql_query($db, \$sql, $g_sql_out);
    my $date = $g_sql_out->[0];
    chomp $date;
    return $date
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub consolidate_merge_arrows
{
    my %tmphash = map {$_, 1} @$g_all_merge_arrows;
    @$g_all_merge_arrows =
        sort {
                my ($a1, $a2) = $a =~ /^(\d+).+?(\d+)$/;
                my ($b1, $b2) = $b =~ /^(\d+).+?(\d+)$/;
                if ($a1 != $b1) {
                    $a1 <=> $b1;
                }
                else {
                    $a2 <=> $b2;
                }
             } keys %tmphash;
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub consolidate_parentages
{
    my %tmphash = map {$_, 1} @$g_all_parentages;
    @$g_all_parentages = sort {$a <=> $b} keys %tmphash;
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub consolidate_clusters
{
    for my $branch (keys %{$g_allclusters}) {
        my @revs = sort {$a <=> $b} keys %{$g_allclusters->{$branch}->{revs}};
        $g_allclusters->{$branch}->{earliest_rev} = shift @revs;
    }
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
{
my $n;
sub print_clusters
{
    my @colors = qw(magenta olivedrab1 deepskyblue2 mediumslateblue
                    plum lightblue salmon cornflowerblue burlywood
                    goldenrod maroon1 orchid2 pink
                   );
    my $ncolors = scalar @colors;
    $n = -1 unless (defined $n);

    for my $branch (sort by_youth keys %{$g_allclusters}) {
        my $fillcolor;
        if ($branch eq 'trunk') {
            $fillcolor = 'orangered';
        }
        else {
            $n++;
            $n = $n % $ncolors;
            $fillcolor = $colors[$n];
        }

        $g_allclusters->{$branch}->{color} = $fillcolor;

        {
            my $shape = 'ellipse';
            my $bordercolor = $fillcolor;
            my $penwidth = 1;
            my ($branch_name_only) = $branch =~ /^([^\@]+)/;
            if (exists $g_requested_branches->{$branch_name_only}) {
                $bordercolor = 'black';
                $penwidth = 4;
            }
            print "    subgraph \"cluster_$branch\" {\n"
                . "        color=white\n"
                . "        node [shape=$shape,style=filled,penwidth=$penwidth,color=$bordercolor,fillcolor=$fillcolor,fontsize=14]\n"
                . "        \"$branch\" [shape=box,tooltip=\"$branch in $fillcolor\"]\n"
                ;
        }

        my $oldrev = $branch;
        for my $rev (sort {$a <=> $b} keys %{$g_allclusters->{$branch}->{revs}}) {
            my $date = $g_allclusters->{$branch}->{revs}->{$rev};
            print "        \"$rev\" [tooltip=\"$rev \&#10;$branch \&#10;$date\"]\n";
            print "        \"$oldrev\" -> $rev [arrowhead=none,weight=100]\n";
            $oldrev = $rev;
        }
        print "    }\n\n";
    }
}
}

#
# ------------------------------------------------------------------
# ------------------------------------------------------------------
sub by_youth
{
    $g_allclusters->{$a}->{earliest_rev} <=> $g_allclusters->{$b}->{earliest_rev};
}

